home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
score
/
score1.frm
< prev
next >
Wrap
Text File
|
1995-06-17
|
11KB
|
370 lines
VERSION 2.00
Begin Form frmScores
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Double
Caption = "High Scores"
ClientHeight = 3765
ClientLeft = 2850
ClientTop = 1515
ClientWidth = 4230
ControlBox = 0 'False
Height = 4170
Icon = SCORE1.FRX:0000
Left = 2790
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3765
ScaleWidth = 4230
Top = 1170
Width = 4350
Begin Timer Timer1
Interval = 3000
Left = 3420
Top = 3240
End
Begin CommandButton btnNewScore
Caption = "&OK"
Height = 375
Left = 1500
TabIndex = 5
Top = 3240
Width = 1185
End
Begin TextBox txtScore
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 2130
TabIndex = 3
TabStop = 0 'False
Text = "Text2"
Top = 2820
Width = 1965
End
Begin CommandButton btnOK
Caption = "&OK"
Default = -1 'True
Height = 375
Left = 1500
TabIndex = 4
Top = 3480
Width = 1185
End
Begin TextBox txtName
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 360
Left = 120
TabIndex = 0
Text = "Text1"
Top = 2820
Width = 1905
End
Begin ListBox lstScores
BackColor = &H00C0C0C0&
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H000000FF&
Height = 1230
Left = 2160
TabIndex = 2
TabStop = 0 'False
Top = 1080
Width = 1965
End
Begin ListBox lstNames
BackColor = &H00C0C0C0&
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
ForeColor = &H000000FF&
Height = 1230
Left = 120
TabIndex = 1
TabStop = 0 'False
Top = 1080
Width = 1905
End
Begin Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "SCORES"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 195
Left = 2160
TabIndex = 8
Top = 840
Width = 1875
End
Begin Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "PLAYERS"
FontBold = -1 'True
FontItalic = 0 'False
FontName = "MS Sans Serif"
FontSize = 9.75
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 195
Left = 120
TabIndex = 7
Top = 840
Width = 1875
End
Begin Image Image3
Height = 720
Left = 0
Picture = SCORE1.FRX:0302
Top = 5400
Width = 4230
End
Begin Image Image1
Height = 720
Left = 0
Picture = SCORE1.FRX:1E7C
Top = 3840
Width = 4230
End
Begin Image Image2
Height = 720
Left = 0
Picture = SCORE1.FRX:39F6
Top = 4620
Width = 4230
End
Begin Label lblInfo
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Congatulations! You've just achieved a New High Score! Enter your name below:"
ForeColor = &H00FF0000&
Height = 405
Left = 180
TabIndex = 6
Top = 2400
Width = 3765
End
Begin Image imgMain
Height = 720
Left = 0
Picture = SCORE1.FRX:5570
Top = 30
Width = 4230
End
End
Option Explicit
'------------------------------------------------------------
' SCORE1.FRM
' This form is dependent on file SCORE1.BAS.
'------------------------------------------------------------
' Windows API call used to send a message to a window. In
' our case, we use it to send a message to a text box control
' that it should be read-only.
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
' Constants used to make a text box read-only.
Const WM_USER = &H400
Const EM_SETREADONLY = (WM_USER + 31)
Sub btnNewScore_Click ()
'------------------------------------------------------------
' When this button is pressed, save the new player name and
' score, then hide the text boxes and button used to enter
' the player's name, and resize the form.
'------------------------------------------------------------
' Save all high scores back to the .INI file.
AddScoreAndSave txtName, txtScore
DisplayScores
SetForDisplay
End Sub
Sub btnOK_Click ()
'------------------------------------------------------------
' Close the frmScores window when this button is pushed.
'------------------------------------------------------------
Timer1.Enabled = False
Timer1.Interval = 0
DoEvents
Unload Me
End Sub
Sub DisplayScores ()
'------------------------------------------------------------
' Display the scores and player names from the Hi() array
' into the form's list controls.
'------------------------------------------------------------
Dim i As Integer
If Num_HiScores > 0 Then
' Empty the lists.
lstNames.Clear
lstScores.Clear
' Display the high scores in the list boxes.
For i = 1 To Num_HiScores
lstNames.AddItem Hi(i).Name
lstScores.AddItem Format$(Hi(i).Score)
Next
End If
End Sub
Sub Form_Load ()
'------------------------------------------------------------
' When the form is loaded, center it and display the current
' high scores.
'------------------------------------------------------------
Dim rc As Long
' Center the form on the screen.
Me.Left = (Screen.Width - Me.Width) \ 2
Me.Top = (Screen.Height - Me.Height) \ 2
Me.Caption = gGameTitle
' Display current high scores.
DisplayScores
If gDisplayOnly Then
SetForDisplay
Else
btnOK.Visible = False
btnNewScore.Default = True
' Clear text field to let player enter their name.
txtName = ""
txtName.MaxLength = 15
txtScore = Format$(gNewScore)
rc = SendMessage(txtScore.hWnd, EM_